Garbo/Garbo.cdr/mac/hypercrd/xcmd/dxcmds34.sit/Dartmouth XCMD's 3.4.3/card_5128.txt

Text File | 1990-04-17 | 14KB | 436 lines

-- card: 5128 from stack: in.3
-- bmap block id: 0
-- flags: 4000
-- background id: 3241
-- name: WriteToFile
----- HyperTalk script -----
on Install
  get ChooseTargetStack()
  InstallResource XCMD,WriteToFile,it
end Install


-- part 1 (button)
-- low flags: 00
-- high flags: A003
-- rect: left=79 top=300 right=322 bottom=179
-- title width / last selected line: 0
-- icon id / first selected line: 0 / 0
-- text alignment: 1
-- font id: 0
-- text size: 12
-- style flags: 0
-- line height: 16
-- part name: WriteToFile
----- HyperTalk script -----
on mouseUp
  WriteToFile field 1,FALSE,"WriteToFile Docs",FALSE,"MSWD"
  put the result
end mouseUp



-- part 7 (field)
-- low flags: 81
-- high flags: 2007
-- rect: left=12 top=26 right=298 bottom=491
-- title width / last selected line: 0
-- icon id / first selected line: 0 / 0
-- text alignment: 0
-- font id: 22
-- text size: 10
-- style flags: 0
-- line height: 13
-- part name: Source


-- part 8 (button)
-- low flags: 00
-- high flags: A003
-- rect: left=299 top=300 right=322 bottom=438
-- title width / last selected line: 0
-- icon id / first selected line: 0 / 0
-- text alignment: 1
-- font id: 0
-- text size: 12
-- style flags: 0
-- line height: 16
-- part name: Show Pascal Source
----- HyperTalk script -----
on mouseUp
  set the visible of card field 1 to not the visible of card field 1
  if the visible of card field 1 is true then
    set the name of me to "Hide Pascal Source"
  else set the name of me to "Show Pascal Source"
end mouseUp



-- part contents for background part 16
----- text -----
WRITETOFILE XCMD version 1.0
Kevin Calhoun

The WriteToFile XCMD writes the contents of a HyperCard container to a text file.  The file may be designated by its full pathname, or it may be given by the user in a standard file dialog.  WriteToFile can append to an existing file, replace an existing file, or create a new file.

Use some caution when using WriteToFile.  It will overwrite or append to a file you designate by full pathname even if that file is better off left alone.  It does not check whether an existing file is a TEXT file.

If an error occurs, WriteToFile returns an error message as the Result.  Word 1 of this message will be "Error."  If the file was written successfully, WriteToFile returns the full pathname of the file as the Result.

INVOKING WRITETOFILE

WriteToFile container,<usePathname>,<"name">,<append>,<creator>

The first parameter, container, is the name of a HyperTalk container.  This can be a field, a variable, a function, or, in sum, anything you can "get".  For example,

   WriteToFile card field 1

will write the contents of card field 1 to a file, while

  WriteToFile containerName

will write the contents of the HyperTalk variable called "containerName" to a file.

The second parameter, usePathname, tells WriteToFile how to interpret the third parameter.  If usePathname is TRUE, WriteToFile attempts to write to the file whose full pathname is given in parameter 3.  If usePathname is false, WriteToFile invokes standard file with the contents of parameter 3 given as the default name for the file.  If standard file is invoked and the user pushes the cancel button in the dialog box, FileToField returns "Cancel" as the Result.

If the fourth parameter, append, is TRUE, WriteToFile appends to the file rather than replacing its contents.  Note that this parameter has no significance unless the WriteToFile is writing to an existing file designated by full pathname.

If you want to be able to open your favorite word processor by double-clicking in the Finder on the text file that WriteToFile creates, you must supply the creator parameter.  For MacWrite, the creator is "MACA."  For Microsoft Word, the creator is "MSWD."  If you don't specify a creator, WriteToFile will default to MACA.  Note that this parameter is not significant unless WriteToFile is creating a new file.  The creator of an existing file will not be changed.

EXAMPLES

WriteToFile bkgnd field id 3    -- standard file will be invoked
WriteToFile card field 5,TRUE,"TheFattaTheLand:Of Mice And Men:My Book Report"
WriteToFile variableName,TRUE,"MyHD:MyFile",TRUE    -- append to existing file

REVISION HISTORY
30 April 1989   1.0

NOTE TO USERS OF FIELDTOFILE:  WriteToFile does everything that FieldToFile could do, except that it can't write to an AppleShare drop folder.  The parameter list is quite different; the most important difference is that, when using WriteToFile, you must not put a field designation in quotation marks.

-- part contents for card part 7
----- text -----
UNIT DisksEngravedWhileUWait;

{ WriteToFile XCMD © 1988-1989 by the Trustees of Dartmouth College }
{ Written by Kevin Calhoun }

{ This source compatible with MPW Pascal 3.0 }

(*
Pascal WriteToFile.p
Link -m ENTRYPOINT Γêé
     -o "YourFile" Γêé
     -rt XCMD=2240 Γêé
     -sn Main=WriteToFile Γêé
     WriteToFile.p.o Γêé
    "{Libraries}"interface.o Γêé
    "{PLibraries}"Paslib.o Γêé
    "{Libraries}"HyperXLib.o
*)

{$R-}
INTERFACE
  USES
    Types,
    Memory,
    Files,
    Resources,
    Errors,
    Packages,
    HyperXCmd;

  PROCEDURE EntryPoint (paramPtr : XCMDPtr);

IMPLEMENTATION

  PROCEDURE ContainerToFile (paramPtr: XCMDPtr);  FORWARD;

  PROCEDURE EntryPoint (paramPtr : XCMDPtr);
  BEGIN
    ContainerToFile(paramPtr);
  END;

  FUNCTION GetScreenBitsBounds: Rect;
  { get screenbits.bounds from the QuickDraw globals }
  TYPE
    LongwordPtr = ^LONGINT;
    BitMapPtr = ^BitMap;
  CONST
    screenBitsOffset = -122;
    CurrentA5 = $904;
  VAR
    screenBitsPtr : BitMapPtr;
    myLongwordPtr : LongwordPtr;
  BEGIN
    myLongwordPtr := LongwordPtr(CurrentA5);
      { myLongwordPtr now points to the pointer to the first QD global }
    myLongwordPtr := LongwordPtr(myLongwordPtr^);
      { myLongwordPtr now points to the first QD global }
    screenBitsPtr := BitMapPtr(myLongwordPtr^ + screenBitsOffset);
      { screenBitsPtr now points to the screenBits BitMap }
    GetScreenBitsBounds := screenBitsPtr^.bounds;
  END;

  FUNCTION BuildThePathname (fName : Str255;
                  vRefNum : INTEGER) : Str255;
{ Given the "short name" and vRefNum of a file, returns the full pathname. }
{ This function is adapted from Steve Maller's FileName XFCN published in }
{ HyperTalk Programming by Dan Shafer, Howard W. Sams & Company, 1988, }
{ pp. 399-403. }
    VAR
      name, fullPathName : Str255;
      err : INTEGER;
      myWDPB : WDPBPtr;
      myCPB : CInfoPBPtr;
      myPB : HParmBlkPtr;

  BEGIN
    fullPathName := '';     { start with an empty pathname }
{ Allocate some memory in the heap for the parameter block. }
    myCPB := CInfoPBPtr(NewPtr(SizeOf(HParamBlockRec)));
    IF ord4(myCPB) > 0 THEN    { continue if mem allocation was OK }

      BEGIN
        myWDPB := WDPBPtr(myCPB);
        myPB := HParmBlkPtr(myCPB);
{ same pointer, different variations of the record -- see IM IV, p. 117 }
        name := '';     { start with an empty name for the volume }

        WITH myPB^ DO
          BEGIN
            ioNamePtr := @name;   { we want the volume name }
            ioCompletion := pointer(0);
            ioVRefNum := vRefNum;  { returned by SFGetFile }
            ioVolIndex := 0;  { use the vRefNum and name only to designate volume }
          END;
        err := PBHGetVInfo(myPB, FALSE);  { fill in the volume info }
        IF err = noErr THEN

          BEGIN
{ Now we need the Working Directory (WD) information because we're }
{ going to step backwards from the file through all of the folders until }
{ we reach the root directory. }
            WITH myWDPB^ DO
              BEGIN
                ioVRefNum := vRefNum;  { this got set to 0 above }
                ioWDProcID := 0;   { use the vRefNum }
                ioWDIndex := 0;     { we want all directories }
              END;
            err := PBGetWDInfo(myWDPB, FALSE);
            IF err = noErr THEN
              BEGIN
                WITH myCPB^ DO
                  BEGIN
                    ioFDirIndex := -1;   { use the ioDirID field only }
                    ioDrDirID := myWDPB^.ioWDDirID;   { info returned above }
                  END;
                err := PBGetCatInfo(myCPB, FALSE);
                IF err = noErr THEN
                  BEGIN

{ Here starts the real work -- start to climb the tree by continually }
{ looking in the ioDrParID field for the next directory above until we fail... }
                    myCPB^.ioDrDirID := myCPB^.ioDrParID;  { the first folder }
                    fullPathName := CONCAT(myCPB^.ioNamePtr^, ':', fName);
                    REPEAT
                      myCPB^.ioDrDirID := myCPB^.ioDrParId;
                      err := PBGetCatInfo(myCPB, FALSE);    { the next level }
{ Be careful of an error returned here -- it means the user chose a file on the }
{ desktop level of this volume.  If this is the case, just stop here and return }
{ "VolumeName:FileName"; otherwise loop until failure. }
                      IF err = noErr THEN
                        fullPathName := CONCAT(myCPB^.ioNamePtr^, ':', fullPathName);
                    UNTIL err <> noErr;
                  END;  { if PBGetCatInfo worked OK }
              END;  { if PBGetWDInfo worked OK }
          END;  { if PBHGetVInfo worked OK }
        DisposPtr(pointer(myCPB));
      END;  { if we had enough room for a new pointer }
    BuildThePathname := fullPathName;
  END;

  PROCEDURE GetFileName(paramPtr:XCMDPtr; var str:Str255);
  BEGIN
    IF paramPtr^.paramCount > 2 THEN ZeroToPas(paramPtr, paramPtr^.params[3]^, str)
    ELSE str := '';
  END;

  PROCEDURE GetCreator(paramPtr: XCMDPtr; VAR creator: OSType);
  VAR
    str: Str255;
  BEGIN
    IF paramPtr^.paramCount > 4 THEN
      BEGIN
        str := '    ';
        ZeroToPas(paramPtr, paramPtr^.params[5]^, str);
        BlockMove(Ptr(ORD4(@str)+1),@creator,4);
      END
    ELSE creator := 'MACA';
  END;

  FUNCTION GotFileFromSFPut(var volume: INTEGER; var fileName: Str255): BOOLEAN;
  VAR
    where : Point;
    reply : SFReply;
    dlgt: DialogTHndl;
    r: rect;
    screen: rect;
    h, v: INTEGER;
  BEGIN
    dlgt := DialogTHndl(GetResource('DLOG',putDlgID));
    if dlgt <> nil then
      begin
      r := dlgt^^.boundsRect;
      screen := GetScreenBitsBounds;
      h := ((screen.right - screen.left) - (r.right - r.left)) div 2;
      v := ((screen.bottom - screen.top) - (r.bottom - r.top)) div 2;
      SetPt(where, h, v);
      end
    else SetPt(where, 82, 75);
    SFPutFile(where, '', fileName, NIL, reply);
    WITH reply DO
      BEGIN
      IF good THEN
        BEGIN
        fileName := fName;
        volume := vRefNum;
        END;
      GotFileFromSFPut := good;
      END;
  END;

  FUNCTION FlushVolOfFile(fRefNum: INTEGER): OSErr;
    LABEL 99;
    VAR
      err: OSErr;
      myFCBPBHndl: Handle;
      myFCBPBPtr: FCBPBPtr;
  BEGIN
    err := noErr;
    myFCBPBHndl := NewHandleClear(SIZEOF(FCBPBRec));
    err := MemError;
    IF err <> noErr THEN GOTO 99;

    MoveHHi(myFCBPBHndl);
    HLock(myFCBPBHndl);

    myFCBPBPtr := FCBPBPtr(myFCBPBHndl^);
    myFCBPBPtr^.ioRefNum := fRefNum;
    err := PBGetFCBInfo(myFCBPBPtr, FALSE);
    IF err=noErr THEN err := FlushVol(NIL,myFCBPBPtr^.ioVRefNum);

    DisposHandle(myFCBPBHndl);
    99: FlushVolOfFile := err;
  END;

  FUNCTION WriteToFile(vRefNum: INTEGER; fileName: Str255;
                       textPtr: Ptr; VAR count: LONGINT;
                       creator: OSType; append: BOOLEAN): OSErr;
    LABEL
      98,99;
    VAR
      err: OSErr;
      fRefNum: INTEGER;
      fileLength: LONGINT;
  BEGIN
    err := Create(fileName,vRefNum,creator,'TEXT');
    IF (err <> noErr)&(err<>dupFNErr) THEN GOTO 99;

    err := FSOpen(fileName,vRefNum,fRefNum);
    IF err <> noErr THEN GOTO 99;

    IF append THEN
      BEGIN
      err := GetEOF(fRefNum,fileLength);
      IF err <> noErr THEN GOTO 98;
      END
    ELSE fileLength := 0;
    err := SetFPos(fRefNum,fsFromStart,fileLength);
    IF err <> noErr THEN GOTO 98;

    err := FSWrite(fRefNum, count, textPtr);
    IF err<>noErr THEN GOTO 98;

    err := SetEOF(fRefNum, fileLength+count);
    err := FlushVolOFFile(fRefNum);

    98: err := FSClose(fRefNum);
    99: WriteToFile := err;
  END;

  PROCEDURE ContainerToFile (paramPtr : XCMDPtr);
    LABEL 100;
    VAR
      theText: Handle;
      str: Str255;
      vRefNum: INTEGER;
      usePathName: BOOLEAN;
      creator: OSType;
      append: BOOLEAN;
      hs: SignedByte;
      theLength: LONGINT;
      err : OSErr;

    PROCEDURE PassReturnValue (theMsg : Str255); { set theResult and quit }
    BEGIN
      paramPtr^.returnValue := PasToZero(paramPtr, theMsg);
    END;

  BEGIN
    err := noErr;
    IF paramPtr^.paramCount < 1 THEN
      BEGIN
      PassReturnValue('WriteToFile XCMD 1.0, 30 April 1989, ©1988-1989 Dartmouth College');
      GOTO 100;
      END;

    theText := paramPtr^.params[1];
    usePathName := FALSE;
    IF paramPtr^.paramCount > 1 THEN
      BEGIN
      ZeroToPas(paramPtr,paramPtr^.params[2]^,str);
      usePathName := StrToBool(paramPtr,str);
      END;

    append := FALSE;
    IF paramPtr^.paramCount > 3 THEN
      BEGIN
      ZeroToPas(paramPtr,paramPtr^.params[4]^,str);
      append := StrToBool(paramPtr,str);
      END;

    GetFileName(paramPtr,str);
    IF usePathName THEN
      BEGIN
      vRefNum := 0;
      IF LENGTH(str) = 0 THEN
        BEGIN
        err := bdNamErr;
        GOTO 100;
        END;
      END
    ELSE
      IF NOT GotFileFromSFPut(vRefNum,str) THEN
        BEGIN
        PassReturnValue('Cancel');
        GOTO 100;
        END;

    GetCreator(paramPtr,creator);
    hs := HGetState(theText);
    HLock(theText);
    theLength := StringLength(paramPtr, theText^);
    err := WriteToFile(vRefNum,str,theText^,theLength,creator,append);
    HSetState(theText,hs);
    IF NOT usePathName THEN str := BuildThePathName(str,vRefNum);
    PassReturnValue(str);

    100: IF err <> noErr THEN
      BEGIN
      NumToStr(paramPtr,err,str);
      PassReturnValue(CONCAT('Error ',str));
      END;
  END;

END.